home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO106.dsk / POLYTRIS / POLYTRIS.SRC.bas < prev   
BASIC Source File  |  2012-02-16  |  10KB  |  224 lines
  1. 10  REM  
  2. 11  REM          <CTRL-O> T E T R I S <CTRL-N>         
  3. 12  REM  ------------------------------
  4. 13  REM   (c) 1990 Alistair Croll      
  5. 14  REM       and Platypus Programming 
  6. 15  REM  ------------------------------
  7. 16  REM      This is  a public  domain 
  8. 17  REM   program.  It may be copied & 
  9. 18  REM   distributed, but not sold.   
  10. 19  REM  <CTRL-J><CTRL-J>
  11. 20  DIM BP%(5,1),BC%(5,1),BL%(18,5,1)
  12. 25 A = 1:B = 1:SO =  -16336
  13. 120 L = 1
  14. 200  PRINT  CHR$(17): TEXT : HOME 
  15. 999 SC = 0: GOSUB 50000: GOTO 10000
  16. 1000  REM <CTRL-J>Level assignment<CTRL-J>
  17. 1005 LM = 0:AB = 0:XL = XG:XR = XD:UL = UB:XB = 0
  18. 1007  IF   NOT LN  AND L >8  THEN LN = L *5
  19. 1010  IF L >8  THEN  GOSUB 1260: RETURN 
  20. 1015  ON L GOSUB 1100,1120,1140,1160,1180,1200,1220,1240
  21. 1020  RETURN 
  22. 1100 PZ = 60:YB = .5:LN = 5: RETURN 
  23. 1120 PZ = 1:YB = .5:LN = 10: RETURN 
  24. 1140 PZ = 160:YB = 1:LN = 10: RETURN 
  25. 1160 PZ = 130:YB = 1:LN = 15: RETURN 
  26. 1180 XT = 3
  27. 1185 PZ = 100:YB = 1:LN = 15: RETURN 
  28. 1200 XT = 6
  29. 1205 PZ = 80:YB = 1:LN = 20: RETURN 
  30. 1220 PZ = 60:YB = 1:LN = 20:XL = XG -1:XR = XD +1:UL = UB +2:AB = 10: RETURN 
  31. 1240 PZ = 40:YB = 1:LN = 25:XL = XG +1:XR = XD -1:UL = UB -1:AB = 7: RETURN 
  32. 1260  IF PZ  THEN PZ = PZ -15
  33. 1263  IF PZ <1  THEN PZ = 0
  34. 1265 LN = LN +5:UL = 4:AB = 5:YB = 1:XB = 4: RETURN 
  35. 2000  REM <CTRL-J>Draw screen<CTRL-J>
  36. 2005  HOME : GR : COLOR= 12
  37. 2010  VLIN 0,BT AT XL: VLIN 0,BT AT XR
  38. 2015  VLIN 0,39 AT 0: VLIN 0,39 AT 39: HLIN 0,XL AT 0: HLIN XR,39 AT 0: HLIN 0,39 AT 39
  39. 2020  HLIN XL,XR AT BT +1
  40. 2030  VTAB 21: HTAB 2: INVERSE : PRINT "  LEVEL  ": VTAB 21: HTAB 30: PRINT "LINES MADE": NORMAL 
  41. 2040  VTAB 23: HTAB 1: PRINT "Score:": GOSUB 3000
  42. 2050  VTAB 23: HTAB 21: PRINT "Hiscore: "; RIGHT$("0000000" + STR$(HS),8)
  43. 2060  VTAB 22: HTAB 4: PRINT  RIGHT$("000" + STR$(L),4)
  44. 2070  IF XT  THEN  FOR T = 1 TO XT: GOSUB 30000: NEXT T
  45. 2999  RETURN 
  46. 3000  REM <CTRL-J>Print score<CTRL-J>
  47. 3010  VTAB 23: HTAB 8: PRINT  RIGHT$("0000000" + STR$(SC),8)
  48. 3020  VTAB 22: HTAB 31: PRINT  RIGHT$("000" + STR$(LM),4);"/"; RIGHT$("000" + STR$(LN),4)
  49. 3030  RETURN 
  50. 4000  REM <CTRL-J>Pick random block<CTRL-J>
  51. 4010 V =  INT( RND( PDL(1) + PEEK(78) +SC *L) *NP) +1
  52. 4015 HP =  INT( RND(V) *(XR -XL -6)) +XL +3
  53. 4020  RETURN 
  54. 5000  REM <CTRL-J>Display next block<CTRL-J>
  55. 5010 CB = NX: GOSUB 4000:NX = V
  56. 5020  IF F2%  THEN NX = V:HZ = 32:VZ = 5:ER% = 1:V = CB: GOSUB 6000:V = NX: GOSUB 6000
  57. 5030  RETURN 
  58. 6000  REM <CTRL-J>Draw block V at H,V<CTRL-J>
  59. 6010  COLOR= V/DV +1: IF ER%  THEN ER% = 0: COLOR= 0
  60. 6020  FOR A = 1 TO NB: PLOT HZ +BL%(V,A,0),VZ +BL%(V,A,1): NEXT : RETURN 
  61. 6100  REM <CTRL-J>Draw current block at XP,YP<CTRL-J>
  62. 6110  COLOR= C
  63. 6120  FOR A = 1 TO NB: PLOT BP%(0,0) +BP%(A,0),YP +BP%(A,1): NEXT 
  64. 6130  RETURN 
  65. 7000  REM <CTRL-J>Get movement<CTRL-J>
  66. 7010 PK =  PDL(0):RK =  PEEK( -16287)
  67. 7020 X = 0 -(PK <100) +(PK >180):R = 0 +(RK >127)
  68. 7030  RETURN 
  69. 8000  REM <CTRL-J>Check BC% (Where block WILL be) for collisions<CTRL-J>
  70. 8010 CO = 0
  71. 8015  FOR A = 1 TO NB
  72. 8020 S =  SCRN( BC%(0,0) +BC%(A,0),YC +BC%(A,1)):CO = CO +(S < >15  AND S < >0)
  73. 8030  NEXT 
  74. 8040  RETURN 
  75. 9000  REM <CTRL-J>Check if block landed<CTRL-J>
  76. 9010 CO = 0
  77. 9020  FOR A = 1 TO NB
  78. 9030 S =  SCRN( BP%(0,0) +BP%(A,0),YP +BP%(A,1) +1):CO = CO +(S < >15  AND S < >0): NEXT 
  79. 9040  RETURN 
  80. 10000  REM <CTRL-J>Main program<CTRL-J>
  81. 10010  GOSUB 1000: REM  Load stats for level L
  82. 10015 MI = BT
  83. 10020  GOSUB 2000: REM  Draw level L screen
  84. 10030  GOSUB 4000:NX = V
  85. 10040  GOSUB 5000: GOSUB 14000
  86. 10043  IF   NOT AB  THEN 10050
  87. 10044 XB = XB +1: IF XB = AB  THEN XB = 0: GOSUB 30000
  88. 10045  IF   NOT AB  THEN 10050
  89. 10050 BP%(0,0) = HP:YP = 3
  90. 10060 C = 15: GOSUB 6100
  91. 10070  GOSUB 7000
  92. 10075  FOR A = 1 TO PZ: NEXT 
  93. 10080  IF   NOT (X)  AND   NOT (R)  THEN C = 0: GOSUB 6100:YP = YP +YB: GOTO 10140
  94. 10090 BC%(0,0) = BP%(0,0) +X:YC = YP +YB: IF   NOT (R)  THEN  FOR A = 1 TO NB: FOR B = 0 TO 1:BC%(A,B) = BP%(A,B): NEXT : NEXT : GOTO 10110
  95. 10100  FOR A = 1 TO NB:BC%(A,1) =  -(BP%(A,0)):BC%(A,0) = BP%(A,1): NEXT 
  96. 10110  GOSUB 8000
  97. 10115 C = 0: GOSUB 6100
  98. 10120  IF CO  THEN YP = YP +YB: GOTO 10140
  99. 10130  FOR A = 0 TO NB: FOR B = 0 TO 1:BP%(A,B) = BC%(A,B): NEXT : NEXT :YP = YC
  100. 10140 C = 15: GOSUB 6100
  101. 10150  GOSUB 9000
  102. 10160  IF   NOT CO  THEN 10070
  103. 10170 SD =  PEEK(SO):SD =  PEEK(SO):SD =  PEEK(SO)
  104. 10180 TP = 40: FOR A = 1 TO NB: IF YP +BP%(A,1) <TP  THEN TP = YP +BP%(A,1)
  105. 10185  IF TP <MI  THEN MI = TP
  106. 10190  NEXT : IF TP <UL  THEN 20000
  107. 10195 LC = 0
  108. 10200 C = CB/DV +1: GOSUB 6100
  109. 10210 F = 0: FOR A = BT TO MI  STEP  -1
  110. 10220  GOSUB 13000: IF (CO)  THEN 10240
  111. 10230 F = F +1: GOSUB 11000:A = MI -1
  112. 10240  NEXT 
  113. 10250  IF F  THEN 10210
  114. 10270  IF LC  THEN SC = SC +100 *LC *LC:LM = LM +LC: GOSUB 3000
  115. 10280  IF LM > = LN  THEN L = L +1:TP = BT -1:LM = 0: GOTO 10010
  116. 10290  GOTO 10040
  117. 11000  REM <CTRL-J>Delete row A from box<CTRL-J>
  118. 11010  FOR T = A -1 TO MI  STEP  -1
  119. 11020  FOR P = XL +1 TO XR -1
  120. 11030  COLOR=  SCRN( P,T): PLOT P,T +1
  121. 11033 SD =  PEEK(SO)
  122. 11035  NEXT : NEXT 
  123. 11045  COLOR= 0: HLIN XL +1,XR -1 AT MI:MI = MI +1: HLIN XL,XR AT BT +2
  124. 11050 TP = TP +1:LC = LC +1
  125. 11060  COLOR= 12: HLIN XL,XR AT BT +1
  126. 11070  RETURN 
  127. 13000  REM <CTRL-J>Check line A for completion<CTRL-J>
  128. 13010 CO = 0: FOR B = XL +1 TO XR -1: IF  SCRN( B,A) = 0  THEN CO = 1:B = XR
  129. 13020  NEXT : RETURN 
  130. 14000  REM <CTRL-J>Randomize block position<CTRL-J>
  131. 14010  FOR A = 1 TO NB: FOR B = 0 TO 1:BP%(A,B) = BL%(CB,A,B): NEXT : NEXT 
  132. 14020  FOR A = 1 TO  INT( RND( PEEK(78) *SC +HS + PDL(1)) *4) +1
  133. 14030  FOR T = 1 TO NB:K% = BP%(T,1):BP%(T,1) =  -(BP%(T,0)):BP%(T,0) = K%: NEXT 
  134. 14040  RETURN 
  135. 20000  REM <CTRL-J>Game over<CTRL-J>
  136. 20010  TEXT : POKE 35,20: HOME : TEXT : VTAB 12: HTAB 1: PRINT "         G A M E   O V E R": PRINT : IF SC > = HS  THEN  GOSUB 21000
  137. 20015  VTAB 16: HTAB 1: PRINT "(P)lay again, (Q)uit, (C)ontinue: ";: GET AN$: ON (AN$ = "C"  OR AN$ = "c") GOTO 10000: IF AN$ = "Q"  OR AN$ = "q"  THEN  PRINT A$: END 
  138. 20020  PRINT AN$: GOTO 999
  139. 21000 S$ =  RIGHT$("0000000" + STR$(SC),8)
  140. 21005  VTAB 18: INVERSE : HTAB 3: PRINT "CONGRATULATIONS!  A HIGH SCORE!"
  141. 21006  NORMAL 
  142. 21020  FOR T = 8 TO 30
  143. 21030  VTAB 23: HTAB T: PRINT S$: FOR P = 1 TO 100: NEXT P:SD =  PEEK(SO) + PEEK(SO)
  144. 21040  VTAB 23: HTAB T: PRINT "        "
  145. 21050  VTAB 23: HTAB 21: PRINT "Hiscore:"
  146. 21060  NEXT T
  147. 21070 HS = SC
  148. 21075  VTAB 23: HTAB 30: PRINT S$
  149. 21080  FOR T = 1 TO 500: NEXT T: RETURN 
  150. 30000  REM <CTRL-J>Add a garbage line (scroll up)<CTRL-J>
  151. 30005 MI = MI -1
  152. 30010  FOR A = MI TO BT -1
  153. 30020  FOR P = XL +1 TO XR -1
  154. 30030  COLOR=  SCRN( P,A +1): PLOT P,A
  155. 30050  NEXT : NEXT 
  156. 30070 TP = TP +1
  157. 30080  FOR A = XL +1 TO XR -1:SD =  PEEK(SO) + PEEK(SO): COLOR=  INT( RND( PEEK(78) + PDL(1)) *4): PLOT A,BT: NEXT 
  158. 30090  COLOR= 0: PLOT  INT( RND( PEEK(78) + PDL(1)) *((XR -XL) -4)) +XL +2,BT
  159. 30100  COLOR= 14: HLIN XL,XR AT BT +1: RETURN 
  160. 50000  REM <CTRL-J>Start screen<CTRL-J>
  161. 50001  TEXT : HOME : VTAB 1: HTAB 1
  162. 50002  VTAB 1: HTAB 1: FOR T = 1 TO 20: PRINT "==";: NEXT 
  163. 50004  PRINT "       __"
  164. 50005  PRINT "      |__) _  |      -|- ._  .   _"
  165. 50006  PRINT "      |   (_) !_ !__| !_ |   | _/"
  166. 50007  PRINT "                  __!"
  167. 50015  VTAB 7: HTAB 1: FOR T = 1 TO 20: PRINT "==";: NEXT : PRINT 
  168. 50020 V = 16:S$ = "Show next block?": GOSUB 51000
  169. 50030 F2% = 0 +(AN$ = "Y"  OR AN$ = "y")
  170. 50040 V = 18:S$ = "Sound (Y/N)?": GOSUB 51000
  171. 50050 SO =  -16336: IF AN$ < >"Y"  AND AN$ < >"y"  THEN SO = 0
  172. 50060 V = 20:S$ = "Level to start at:": GOSUB 51000
  173. 50070 L = 1:AN =  VAL(AN$): IF AN >0  THEN L = AN
  174. 50080 V = 22:S$ = "3, 4, or 5 block pieces?": GOSUB 51000
  175. 50090 AN =  VAL(AN$): IF AN <3  OR AN >5  THEN 50080
  176. 50100 PC = AN
  177. 50110  GOSUB 59000
  178. 50999  RETURN 
  179. 51000  REM <CTRL-J>Scroll question on<CTRL-J>
  180. 51010  FOR T = 1 TO  LEN(S$): VTAB V: HTAB (40 -T): PRINT  LEFT$(S$,T):SD =  PEEK(SO): FOR P = 1 TO 15: NEXT : NEXT 
  181. 51020  FOR T = 40 - LEN(S$) TO 1  STEP  -1: VTAB V: HTAB T: PRINT S$;" ";: FOR P = 1 TO (40 -T)/2:: NEXT :SD =  PEEK(SO): NEXT 
  182. 51030  VTAB V: HTAB ( LEN(S$) +2): GET AN$: PRINT AN$
  183. 51040  RETURN 
  184. 59000  REM <CTRL-J>Load in block data<CTRL-J>
  185. 59005  RESTORE 
  186. 59010  ON PC -2 GOSUB 59020,59030,59040: GOTO 59100
  187. 59020 XG = 16:XD = 24:UB = 5:BT = 26:NB = 3:NP = 3:DV = 1: FOR T = 1 TO 18: FOR X = 1 TO 10: READ A: NEXT : NEXT : FOR T = 1 TO 7: FOR X = 1 TO 8: READ A: NEXT : NEXT : RETURN 
  188. 59030 XG = 15:XD = 25:UB = 6:BT = 29:NB = 4:NP = 7:DV = 1: FOR T = 1 TO 18: FOR X = 1 TO 10: READ A: NEXT : NEXT : RETURN 
  189. 59040 XG = 13:XD = 27:UB = 4:BT = 34:NB = 5:NP = 18:DV = 2: RETURN 
  190. 59100  FOR X = 1 TO NP
  191. 59120  FOR Y = 1 TO NB
  192. 59130  FOR T = 0 TO 1
  193. 59140  READ BL%(X,Y,T)
  194. 59150  NEXT : NEXT : NEXT 
  195. 59160  RETURN 
  196. 60000  REM <CTRL-J>Block Data<CTRL-J>
  197. 60010  DATA  0,0,-1,0,1,0,-1,1,0,1
  198. 60020  DATA  0,0,-1,-1,0,-1,-1,0,1,0
  199. 60030  DATA  0,0,0,-2,0,-1,1,0,1,1
  200. 60040  DATA  0,0,1,-1,1,0,0,1,0,2
  201. 60050  DATA  0,0,0,-2,0,-1,0,1,0,2
  202. 60060  DATA  0,0,-1,-1,-1,0,1,0,1,1
  203. 60070  DATA  0,0,-1,1,-1,0,1,0,1,-1
  204. 60080  DATA  0,0,0,-1,1,-1,0,1,0,2
  205. 60090  DATA  0,0,0,-1,1,0,0,1,0,2
  206. 60100  DATA  0,0,0,-2,0,-1,1,0,0,1
  207. 60110  DATA  0,0,0,-2,0,-1,0,1,1,1
  208. 60120  DATA  0,0,-1,-1,-1,0,1,0,1,-1
  209. 60130  DATA  0,0,-1,0,1,0,0,1,0,2
  210. 60140  DATA  0,0,-1,0,0,1,1,0,-1,1
  211. 60150  DATA  0,0,-1,-1,-1,0,0,1,1,0
  212. 60160  DATA  0,0,-1,0,0,-1,0,1,1,0
  213. 60170  DATA  0,0,0,-2,0,-1,1,0,2,0
  214. 60180  DATA  0,0,-1,0,-1,-1,0,1,1,1
  215. 61010  DATA  0,0,1,0,0,1,1,1
  216. 61020  DATA  0,0,0,1,-1,0,-2,0
  217. 61030  DATA  0,0,0,1,1,0,2,0
  218. 61040  DATA  0,0,1,0,0,1,-1,0
  219. 61050  DATA  0,0,-1,0,1,0,2,0
  220. 61060  DATA  0,0,-1,-1,0,-1,1,0
  221. 61070  DATA  0,0,-1,0,0,-1,1,-1
  222. 62000  DATA  0,0,-1,0,1,0
  223. 62010  DATA  0,0,0,-1,1,0
  224. 62030  DATA  0,0,0,-1,-1,0